home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok11 / r.o.m. / m2sources / mylongrealconversions.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  333 lines
  1. IMPLEMENTATION MODULE MyLongRealConversions;    
  2. (*
  3.   Created:   10.02.88
  4.   Changed:   25.02.88/10.3.88/3.8.88 by 
  5.              Stefan Salewski
  6.              Stolper Weg 3
  7.              2160 Stade   West-Germany
  8.              Tel: 04141/61130
  9.              
  10.   Note: compiled with AMIGA Modula-2 System by AMSoft Verion from 5.5.88
  11.    
  12.   This Module may be freely copied. But please
  13.   leave my name in. Thanks....Stefan 
  14. *)    
  15.  
  16. FROM SYSTEM IMPORT ADR;
  17. FROM Arts IMPORT Assert;
  18. FROM MyUties IMPORT Max,Min,exp10,Nummer,Ziffer,AddOp,IsADigit,
  19.   DeziNummer,DeziZiffer;
  20.   
  21.   CONST
  22.     ExpoStellen=3;
  23.     seven=7;
  24.     
  25.   PROCEDURE RealToStr(x:LONGREAL;VAR str:ARRAY OF CHAR;m,n:INTEGER);
  26.   (* ABS(m) gibt die Anzahl der gueltigen Ziffern an,ABS(n) die Nachkomma-
  27.   stellen. n ist eingeschraenkt durch m, m wiederum durch HIGH(str).
  28.      Es sollte gelten: ABS(n) < ABS(m) < HIGH(str).
  29.      Ist m negativ, so wird die Zahl linksbuendig, sonst rechtsbuendig in
  30.      str eingetragen. Ist n negativ, so wird Exponetialdarstellung verwendet.
  31.      Der String muss mindesten 10 Zeichen gross sein (-n.mE+abc), sonst
  32.      bricht das Programm ab.
  33.      Ist die Zahl in normaler Notation  zu gross fuer str, so wird die
  34.      Exponentialdarstellung  gewaehlt.
  35.      Beispiel:HIGH(str)=10
  36.      x:=-123.456789 m= 6 n=2   ==> '  -123.45'
  37.      x:=-123.456789 m=-6 n=2   ==> '-123.45  '
  38.      x:=123.456789  m=-6 n=2   ==> ' 123.45  '
  39.      x:=123.456789  m=6  n=-2  ==> ' 1.2E+002'
  40.    *)
  41.     VAR
  42.       vk,nk,startpos,pos,i:INTEGER;
  43.       point,leadzero:[-1..1];
  44.       cardX:DeziNummer;
  45.       ex:INTEGER;
  46.       delta,z:LONGREAL;
  47.       expo,neg,mNeg:BOOLEAN;
  48.     
  49.     PROCEDURE Norm(VAR x:LONGREAL;VAR ex:INTEGER;d:LONGREAL);
  50.     (* x >=0.0   d >= 0.0!!!!!!!!!!!!!!!!!!! *)
  51.     BEGIN
  52.       ex:=0;
  53.       IF x#0.0 THEN
  54.         WHILE (x+d < 1.0E-19) DO
  55.           DEC(ex,20);
  56.           x:=x*1.0E20
  57.         END;
  58.         WHILE (x+d < 1.0) DO
  59.           DEC(ex);
  60.           x:=x*1.0E1
  61.         END;
  62.       END;
  63.       WHILE (x+d)>=1.0E20 DO
  64.         INC(ex,20);
  65.         x:=x*1.0E-20
  66.       END;
  67.       WHILE (x+d)>=10.0 DO
  68.         INC(ex);
  69.         x:=x*0.1
  70.       END
  71.       (* oldx=x*10^ex *)
  72.     END Norm;
  73.   
  74.   BEGIN (* RealToStr*)
  75.     Assert(HIGH(str)>=9,ADR('RealToStr:str zu klein'));
  76.     mNeg:=(m<0);
  77.     m:=ABS(m);
  78.     m:=Min(m,HIGH(str)-seven);
  79.     m:=Max(m,2);
  80.     FOR i:=0 TO HIGH(str) DO
  81.       str[i]:=fillChar
  82.     END;
  83.     neg:=(x<0.0);
  84.     x:=ABS(x);
  85.     str[HIGH(str)]:=0C;
  86.     expo:=(n<0) OR (x>=exp10(m));
  87.     n:=ABS(n);
  88.     n:=Min(n,m-1);
  89.     IF expo THEN
  90.       z:=x;
  91.       nk:=Min(n+1,m);
  92.       nk:=Max(nk,2);
  93.       IF NOT mNeg THEN
  94.         (* hier: nk= gesamtzifferrnzahl*)
  95.         pos:=Max(m+2,n+1+seven)-(nk+seven);
  96.       ELSE 
  97.         pos:=0
  98.       END;
  99.       IF neg THEN
  100.         str[pos]:='-'
  101.       ELSE
  102.         IF fillChar=' ' THEN
  103.           str[pos]:=' '
  104.         ELSE
  105.           str[pos]:='+'
  106.         END
  107.       END;
  108.       delta:=0.5*exp10(-nk+1);
  109.       Norm(z,ex,delta);
  110.       z:=z+delta;
  111.       INC(pos);
  112.       str[pos]:=Ziffer(CARDINAL(z));
  113.       INC(pos);
  114.       str[pos]:='.';
  115.       INC(pos);
  116.       z:=(z-LONGREAL(CARDINAL(z)))*10.0;
  117.       FOR i:=pos TO pos+nk-2 DO
  118.         cardX:=CARDINAL(z);
  119.         str[i]:=Ziffer(cardX);
  120.         z:=(z-LONGREAL(cardX))*10.0;
  121.       END;
  122.       pos:=pos+nk-1;
  123.       str[pos]:='E';
  124.       INC(pos);
  125.       IF ex<0 THEN
  126.         ex:=-ex;
  127.         str[pos]:='-'
  128.       ELSE
  129.         str[pos]:='+'
  130.       END;
  131.       INC(pos);
  132.       FOR i:=pos+ExpoStellen-1 TO pos BY (-1) DO
  133.         str[i]:=Ziffer(ex MOD 10);
  134.         ex:=ex DIV 10
  135.       END;
  136.       str[pos+ExpoStellen]:=0C
  137.     ELSE
  138.       z:=x;
  139.       Norm(z,ex,0.0);
  140.       nk:=Min(n,m-(ex+1));
  141.       nk:=Max(nk,0);
  142.       (* Annahme:es koennen nk nachkommastellen geschrieben werden
  143.          Auf Grund dieser Annahme wird gerundet.erst dann koennen die
  144.          vorkommastellen genau bestimmt werden. stellt sich heraus,
  145.          stellt sich heraus,das wegen zu vieler vorkommastellen nicht
  146.          alle nachkommastellen geschrieben werden koennen, so ist die
  147.          rundung falsch, neuer versuch mit nk-1 nachkommastellen
  148.        *)
  149.        INC(nk);
  150.     REPEAT
  151.       DEC(nk);
  152.       z:=x;
  153.       delta:=(0.5)*exp10(-nk);(*delta<=1.0*)
  154.       z:=z+delta;
  155.       Norm(z,ex,0.0);
  156.       vk:=Max(ex+1,0);(*Vorkommastellen*)
  157.     UNTIL  (nk+vk <= m) OR (nk=0);
  158.       IF nk>0 THEN
  159.         point:=1
  160.       ELSE
  161.         point:=0
  162.       END;
  163.       IF ex<0 THEN
  164.         leadzero:=1
  165.       ELSE
  166.         leadzero:=0
  167.       END;
  168.       IF NOT mNeg THEN
  169.         pos:=Max(m+2,n+1+seven)-(vk+1+nk+point+leadzero)
  170.       ELSE
  171.         pos:=0
  172.       END;
  173.       startpos:=pos;
  174.       IF neg THEN
  175.         str[pos]:='-';
  176.       ELSE
  177.         IF fillChar=' ' THEN
  178.           str[pos]:=' '
  179.         ELSE
  180.           str[pos]:='+'
  181.         END
  182.       END;
  183.       INC(pos);
  184.       IF ex > -1 THEN (*vorkomma*)
  185.         WHILE (pos<vk+1+startpos) DO
  186.           cardX:=CARDINAL(z);
  187.           str[pos]:=Ziffer(cardX);
  188.           z:=(z-LONGREAL(cardX))*10.0;
  189.           DEC(ex);
  190.           INC(pos);
  191.         END;
  192.       ELSE
  193.         str[pos]:='0';
  194.         INC(pos)
  195.       END;
  196.       IF nk#0 THEN
  197.         str[pos]:='.';
  198.         INC(pos);
  199.       END;
  200.       (* nachkomma*)
  201.       startpos:=pos;
  202.       WHILE (ex< -1) AND (pos< startpos+nk) DO
  203.         str[pos]:='0';
  204.         INC(pos);
  205.         INC(ex)
  206.       END;
  207.       WHILE (pos< startpos+nk) DO
  208.         cardX:=CARDINAL(z);
  209.         str[pos]:=Ziffer(cardX);
  210.         z:=(z-LONGREAL(cardX))*10.0;
  211.         INC(pos);
  212.       END;
  213.       str[pos]:=0C;
  214.     END;
  215.   END RealToStr;
  216.   
  217.   PROCEDURE StrToReal(str:ARRAY OF CHAR;VAR x:LONGREAL;VAR error:BOOLEAN);
  218.     VAR
  219.       xNeg,expoNeg:BOOLEAN;
  220.       i,k,hi,p,e,expo:INTEGER;
  221.       w:LONGREAL;
  222.       j:LONGCARD;
  223.   BEGIN
  224.     str[HIGH(str)]:=0C;
  225.     x:=0.0;
  226.     expo:=0;
  227.     p:=-1;
  228.     xNeg:=FALSE;
  229.     expoNeg:=FALSE;
  230.     error:=FALSE;
  231.     i:=0;
  232.     IF fillChar#'-' THEN
  233.       WHILE str[i] = fillChar DO
  234.         INC(i);
  235.       END
  236.     END;
  237.     IF AddOp(str[i]) THEN
  238.       xNeg:=(str[i]='-');
  239.       INC(i)
  240.     END;
  241.     error:= error OR NOT IsADigit(str[i]);(* keine einzige Ziffer vor Komma *)
  242.     IF error THEN
  243.       RETURN
  244.     END;
  245.     WHILE IsADigit(str[i]) DO
  246.       INC(i);
  247.     END;
  248.     IF str[i]='.' THEN
  249.       p:=i;
  250.       INC(i);
  251.       error:= error OR NOT IsADigit(str[i])
  252.     ELSE
  253.       error:= error OR NOT((str[i]='E') OR (str[i]=0C));
  254.       p:=-i
  255.     END;
  256.     WHILE IsADigit(str[i]) DO
  257.       INC(i);
  258.     END;
  259.     e:=i; (* position des eventuell vorhandenen 'E' *)
  260.     IF str[i]='E' THEN
  261.       INC(i);
  262.       IF AddOp(str[i]) THEN
  263.         expoNeg:=(str[i]='-');
  264.         INC(i)
  265.       END;
  266.       error:=error OR NOT IsADigit(str[i]);
  267.       expo:=0;
  268.       k:=0;
  269.       WHILE IsADigit(str[i]) AND (k<ExpoStellen) DO
  270.         expo:=expo*10 + INTEGER(Nummer(str[i]));
  271.         INC(i);
  272.         INC(k);
  273.       END;
  274.       error:= error OR (str[i]#0C);
  275.       IF expoNeg THEN 
  276.         expo:=-expo
  277.       END;
  278.     ELSE
  279.       error:= error OR (str[i]#0C)
  280.     END;
  281.     IF p>0 THEN (* Nachkomma Anteil aufaddieren *)
  282.       i:=e-1;
  283.       w:=1.0E8;
  284.       j:=1;
  285.       k:=i;
  286.       IF IsADigit(str[i]) THEN
  287.         x:=x+ LONGREAL(Nummer(str[i]));
  288.         DEC(i)
  289.       END;
  290.       WHILE IsADigit(str[i]) DO
  291.         IF j<10000000 THEN
  292.         (* Die mathIEEEDoubbas.library der WB1.2 liefert fuer
  293.            LONGREAL(900000000) ein falsches Ergebnis !!!!!!!!!!!!!!! *)
  294.           j:=j*10;
  295.           x:=x+ LONGREAL(j* LONGCARD(Nummer(str[i])))
  296.         ELSE
  297.           x:=x + w*LONGREAL(Nummer(str[i]));
  298.           w:=w*10.0
  299.         END;
  300.         DEC(i)
  301.       END;
  302.       x:=x*exp10(i-k);
  303.     END;
  304.     i:=ABS(p)-1; (* vorkomma Anteil addieren *)
  305.     w:=1.0E8;
  306.     j:=1;
  307.     IF (i>-1) AND IsADigit(str[i]) THEN
  308.       x:=x+ LONGREAL(Nummer(str[i]));
  309.       DEC(i)
  310.     END;
  311.     WHILE (i>-1) AND IsADigit(str[i]) DO
  312.       IF j<10000000 THEN
  313.         (* Die mathIEEEDoubbas.library der WB1.2 liefert fuer
  314.            LONGREAL(900000000) ein falsches Ergebnis !!!!!!!!!!!!!!! *)
  315.         j:=j*10;
  316.         x:=x+ LONGREAL(j* LONGCARD(Nummer(str[i])))
  317.       ELSE
  318.         x:=x + w*LONGREAL(Nummer(str[i]));
  319.         w:=w*10.0 (*kein Fehler durch wiederholte Multiplikation, weil
  320.                     zehnerpotenzen intern sehr genau dargestellt werden *)
  321.       END;
  322.       DEC(i)
  323.     END;
  324.     x:=x*exp10(expo);
  325.     IF xNeg THEN
  326.       x:=-x;
  327.     END;
  328.   END StrToReal; 
  329.   
  330. BEGIN
  331.   fillChar:=' ';
  332. END MyLongRealConversions.mod
  333.